www.gusucode.com > 云网互动影视系统(12套模版和资源联盟) 6.2 > 云网互动影视系统(12套模版和资源联盟) 6.2.4/免费版/Admin/YWNT_TMS_Inc/YWNT_TMS_Function.asp
<%
'===================================================================================================================
'软件名称：云网影视管理系统
'Copyright (C) 2002-2007 ywnt.net All rights reserved.
'产品咨询QQ：489234,2813712
'程序版权：云网互动科技有限公司
'程序开发：云网互动科技有限公司
'官方网站：http://www.ywnt.net
'郑重声明:
' 1、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' 2、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' 3、云网互动科技有限公司保留此软件的法律追究权利
'===================================================================================================================
Function Admin_ShowErr(ErrMsg,ErrorUrl,ErrType)
Select Case ErrType
Case 0
ErrTitle="操作失败"
ErrLeft="×"
Case 1
ErrTitle="操作成功"
ErrLeft="√"
End Select
Response.Write"<table width=""100%"" height=""60%"" border=0 align=""center"" cellpadding=1 cellspacing=0>" &vbcrlf
Response.Write"<tr>" &vbcrlf
Response.Write"<td>" &vbcrlf
Response.Write"<TABLE class=table cellSpacing=1 cellPadding=3 width=""60%"" align=center border=0>" &vbcrlf
Response.Write"<TBODY>" &vbcrlf
Response.Write"<TR>" &vbcrlf
Response.Write"<TD class=xingmu colSpan=3 colspan=2>"&ErrTitle&"</TD>" &vbcrlf
Response.Write"</TR>" &vbcrlf
Response.Write"<TR>" &vbcrlf
Response.Write"<TD class=""hback"" width=""15%"" height=""10"" align=""center""><font style=""font-size:30px;color: #FF0000;""><strong>"&ErrLeft&"</strong></font></TD>" &vbcrlf
Response.Write"<TD class=""hback"" align=""left"" height=""100"">"&ErrMsg&"<li><a href="&ErrorUrl&">返回上一级</a></li></TD>" &vbcrlf
Response.Write"</TR>" &vbcrlf
Response.Write"<TR>" &vbcrlf
Response.Write"<TD class=xingmu colSpan=3 height=""25"" colspan=2></TD>" &vbcrlf
Response.Write"</TR>" &vbcrlf
Response.Write"</TBODY>" &vbcrlf
Response.Write"</TABLE>" &vbcrlf
Response.Write"</td>" &vbcrlf
Response.Write"</tr>" &vbcrlf
Response.Write"</table>"
response.end
End Function
Function NoSqlHack(FS_inputStr)
Dim f_NoSqlHack_AllStr,f_NoSqlHack_Str,f_NoSqlHack_i,Str_InputStr
Str_InputStr=FS_inputStr
f_NoSqlHack_AllStr="dbcc|alter|drop|* |and|exec|or|insert|select|delete|update|count|master|truncate|declare|char|mid(|chr|set |where|xp_cmdshell|tab"
f_NoSqlHack_Str = Split(f_NoSqlHack_AllStr,"|")
For f_NoSqlHack_i=LBound(f_NoSqlHack_Str) To Ubound(f_NoSqlHack_Str)
If Instr(LCase(Str_InputStr),f_NoSqlHack_Str(f_NoSqlHack_i))<>0 Then
If f_NoSqlHack_Str(f_NoSqlHack_i)="'" Then f_NoSqlHack_Str(f_NoSqlHack_i)=" \' "
Response.Write "<html><title>警告</title><body bgcolor=""EEEEEE"" leftmargin=""60"" topmargin=""30""><font style=""font-size:16px;font-weight:bolder;color:blue;""><li>您提交的数据有恶意字符</li></font><font style=""font-size:14px;font-weight:bolder;color:red;""><br><li>您的数据已经被记录!</li><br><li>您的IP："&Request.ServerVariables("Remote_Addr")&"</li><br><li>操作日期："&Now&"</li></font></body></html>"
Response.End
End if
Next
NoSqlHack = Replace(Replace(Str_InputStr,"'","''"),"%27","''")
End Function
Function GetConfig(ByVal ConfigField)
Dim ConfigRS
if application(ConfigField)<>"" then
GetConfig=application(ConfigField)
else
Set ConfigRS = Server.CreateObject(YWNT_TMS_RS)
ConfigRS.Open ("Select "&ConfigField&" From YWNT_TMS_Config"), Conn, 1, 1
application.lock
application(ConfigField)=ConfigRS(ConfigField)
application.unlock
GetConfig = application(ConfigField)
ConfigRS.Close
Set ConfigRS = Nothing
end if
End Function
function IPTypeW(NType)
Select Case NType
case 1
Response.Write"禁止访问"
case 0
Response.Write"容许访问"
end Select
end function
function NoticeTypeW(NType)
Select Case NType
case 1
Response.Write"顶部公告"
case 0
Response.Write"常规公告"
end Select
end function
function NoticeTypeW(NType)
Select Case NType
case 1
Response.Write"顶部公告"
case 0
Response.Write"常规公告"
end Select
end function
function GroupTypeW(NType)
Select Case NType
case 1
Response.Write"个人会员"
case 0
Response.Write"网吧会员"
end Select
end function
function UsersTypeW(NType)
Select Case NType
case 1
Response.Write"包月"
case 0
Response.Write"影币"
end Select
end function
function UsersStateW(NType)
Select Case NType
case 0
Response.Write"正常"
case 1
Response.Write"锁定"
end Select
end function
Function CheckCF(FildName,FildValue,Str_LinkStr)
CheckCF = Conn.execute("select count(ID) from YWNT_TMS_Users where "&FildName&"="&Str_LinkStr& FildValue &Str_LinkStr)(0)
End Function
Function CheckTemplate(FildValue,FildStyle)
CheckTemplate = Conn.execute("select count(ID) from YWNT_TMS_Template where TemplateType="&FildValue&" and StyleID="&FildStyle&"")(0)
End Function
Function UsersGroup(ByVal UsersGroupgField)
On Error Resume Next
Dim GroupRS
Set GroupRS = Server.CreateObject(YWNT_TMS_RS)
GroupRS.Open ("Select GroupName From YWNT_TMS_UsersGroup where ID="&UsersGroupgField), Conn, 1, 1
UsersGroup = GroupRS("GroupName")
GroupRS.Close
Set GroupRS = Nothing
End Function
Function UsersGroupselect(UsersGroupName,UsersGroupType)
Set Rs = server.CreateObject(YWNT_TMS_RS)
Select Case UsersGroupType
Case 0
sql="Select ID,GroupName from YWNT_TMS_UsersGroup where GroupType=0 Order by ID asc"
Case 1
sql="Select ID,GroupName from YWNT_TMS_UsersGroup where GroupType=1 Order by ID asc"
Case Else
sql="Select ID,GroupName from YWNT_TMS_UsersGroup Order by ID asc"
End Select
Rs.open sql,Conn,1,1
if RS.eof then
Response.Write"暂时还没有该类的会员组请先添加会员组"
else
Response.Write"<select name='"&UsersGroupName&"' id='"&UsersGroupName&"'>"
do while not RS.eof
Response.Write"<option value='"&RS("ID")&"'>"&RS("GroupName")&"</option>" &vbcrlf
RS.movenext
loop
Response.Write"</select>"
end if
RS.close
set RS=nothing
End Function
Function UsersGroupEditselect(UsersGroupName,UsersGroupID,UsersGroupType)
Set Rs = server.CreateObject(YWNT_TMS_RS)
Select Case UsersGroupType
Case 0
sql="Select ID,GroupName from YWNT_TMS_UsersGroup where GroupType=0 Order by ID asc"
Case 1
sql="Select ID,GroupName from YWNT_TMS_UsersGroup where GroupType=1 Order by ID asc"
Case Else
sql="Select ID,GroupName from YWNT_TMS_UsersGroup Order by ID asc"
End Select
Rs.open sql,Conn,1,1
if RS.eof then
Response.Write"暂时还没有该类的会员组请先添加会员组"
else
Response.Write"<select name='"&UsersGroupName&"' id='"&UsersGroupName&"'>"
do while not RS.eof%>
<option value="<%= RS("ID") %>" <%if UsersGroupID=RS("ID") then Response.Write("selected")%>><%= RS("GroupName") %></option>
<%RS.movenext
loop
Response.Write"</select>"
end if
RS.close
set RS=nothing
End Function
Function LookType(MovieType)
Select Case MovieType
Case 1
LookType="在线观看"
Case 2
LookType="下载观看"
Case 3
LookType="bobop2p"
Case 4
LookType="原力p2p"
Case 5
LookType="Qvod"
Case 6
LookType="迅雷看看"
Case 7
LookType="NEO泥巴"
Case 8
LookType="OTV网络电视"
End Select
End Function
Function CheckClass(ClassName,FildValue,Str_LinkStr)
CheckClass = Conn.execute("select count(ID) from YWNT_TMS_MovieClass where "&ClassName&"="&Str_LinkStr& FildValue &Str_LinkStr)(0)
End Function
Function CheckFeature(FeatureName,FildValue,Str_LinkStr)
CheckFeature = Conn.execute("select count(ID) from YWNT_TMS_FeatureClass where "&FeatureName&"="&Str_LinkStr& FildValue &Str_LinkStr)(0)
End Function
Function chkinputchar(f_char)
Dim f_name, i, c
f_name = f_char
chkinputchar = True
If Len(f_name) <= 0 Then
chkinputchar = False
Exit Function
End If
For i = 1 To Len(f_name)
c = Mid(f_name, i, 1)
If InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@,.0123456789|-_", c) <= 0 Then
chkinputchar = False
Exit Function
End If
Next
End Function
Function GetChildNewsList(TypeID,CompatStr)
Dim RSclass,TempStr
Set RSclass = Conn.Execute("Select ID,ClassName,ClassID,ClassWith from YWNT_TMS_MovieClass where ClassID="&TypeID&" order by ClassWith asc,id asc" )
TempStr =CompatStr & "<img src=""images/L.gif""></img>"
do while Not RSclass.Eof
GetChildNewsList = GetChildNewsList & "<tr>" &vbcrlf
GetChildNewsList = GetChildNewsList & "<td height=32 class=""hback"" align=""center"">"& RSclass("id")&"</td>" &vbcrlf
GetChildNewsList = GetChildNewsList & "<td height=32 class=""hback""> "& TempStr & RSclass("ClassName") & "</td>" &vbcrlf
GetChildNewsList = GetChildNewsList & "<td height=32 class=""hback"" align=""center"">"&RSclass("ClassWith")&"</td>" &vbcrlf
GetChildNewsList = GetChildNewsList & "<td height=32 class=""hback"" align=""center""><a href=""Admin_Type.asp?ID="&RSclass("ID")&"&Action=Add"">添加子栏目</a>｜<a href=""Admin_Type.asp?ID="&RSclass("ID")&"&Action=Edit"">修改</a>｜<a href=""Admin_Type.asp?ID="&RSclass("ID")&"&Action=Del"">删除</a></td>" &vbcrlf
GetChildNewsList = GetChildNewsList & "</tr>" &vbcrlf
GetChildNewsList = GetChildNewsList &GetChildNewsList(RSclass("ID"),TempStr)
RSclass.MoveNext
loop
RSclass.Close
Set RSclass = Nothing
End Function
Function AddClassID(TypeID,SelectName)
Response.Write"<select name="&SelectName&" id="&SelectName&">"
if TypeID<>"" then
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select ID,ClassName from YWNT_TMS_MovieClass where ID="&TypeID
Rs.open sql,Conn,1,1
if not Rs.eof then
Response.Write"<option value='"&RS("ID")&"'>"&RS("ClassName")&"</option>"
end if
RS.Close
Set RS = Nothing
else
Response.Write"<option value=""0"">做为一级栏目</option>"
end if
Response.Write"</select>"
End Function
Function EditClassID(TypeID,CompatStr,ID)
Dim RSclass,TempStr
Set RSclass = Conn.Execute("Select ID,ClassName,ClassID,ClassWith from YWNT_TMS_MovieClass where ClassID="&TypeID&" order by ClassWith asc,id asc" )
TempStr =CompatStr & "┄"
do while Not RSclass.Eof
if RSclass("ID")=ID then
EditClassID = EditClassID & "<option value="""& RSclass("ID") &""" selected>"
else
EditClassID = EditClassID & "<option value="""& RSclass("ID") &""">"
end if
EditClassID = EditClassID & "├" & TempStr & RSclass("ClassName")
EditClassID = EditClassID & "</option>" & Chr(13) & Chr(10)
EditClassID = EditClassID &EditClassID(RSclass("ID"),TempStr,ID)
RSclass.MoveNext
loop
RSclass.Close
Set RSclass = Nothing
End Function
Function ClassIDJC(ID)
Dim ClassIDRS
if ID=0 then exit Function
Set ClassIDRS = Server.CreateObject(YWNT_TMS_RS)
ClassIDRS.Open ("Select ClassID From YWNT_TMS_MovieClass where ID="&ID), Conn, 1, 1
ClassIDJC = ClassIDRS("ClassID")
ClassIDRS.Close
Set ClassIDRS = Nothing
End Function
Function ClassWithList(TypeID,CompatStr)
Dim RSclass,TempStr
Set RSclass = Conn.Execute("Select ID,ClassName,ClassID,ClassWith from YWNT_TMS_MovieClass where ClassID="&TypeID&" order by ClassWith asc,id asc" )
TempStr =CompatStr & "<img src=""images/L.gif""></img>"
do while Not RSclass.Eof
ClassWithList = ClassWithList & "<form name=""form"" action=""Admin_Type.asp?Action=ClassWithSave"" method=""post"">" &vbcrlf
ClassWithList = ClassWithList & "<tr>" &vbcrlf
ClassWithList = ClassWithList & "<td height=32 class=""hback"" align=""center"">"& RSclass("id")&"</td>" &vbcrlf
ClassWithList = ClassWithList & "<td height=32 class=""hback""> "& TempStr & RSclass("ClassName") & "</td>" &vbcrlf
ClassWithList = ClassWithList & "<td height=32 class=""hback"" align=""center""><input name=""ClassWith"" type=""text"" value="""&RSclass("ClassWith")&""" size=""5""></td>" &vbcrlf
ClassWithList = ClassWithList & "<td height=32 class=""hback"" align=""center""><input name=""ID"" type=""hidden"" value="""&RSclass("ID")&"""><input type=""submit"" name=""Submit"" value=""修改排序""></td>" &vbcrlf
ClassWithList = ClassWithList & "</tr>" &vbcrlf
ClassWithList = ClassWithList & "</form>" &vbcrlf
ClassWithList = ClassWithList &ClassWithList(RSclass("ID"),TempStr)
RSclass.MoveNext
loop
RSclass.Close
Set RSclass = Nothing
End Function
Function SeverName(Id)
On Error Resume Next
Str_Sql = "Select ID,SeverName from YWNT_TMS_Sever where ID="&Id&" order by id asc"
Set Rs_Class = Conn.Execute(Str_Sql)
if Rs_Class.Eof then
Response.Write("服务器已被删除请再选择服务器")
else
Str_ClassInfo=Rs_Class("SeverName")
Rs_Class.close
Set RS_class = Nothing
Response.Write(Str_ClassInfo)
end if
End Function
Function Servertop()
On Error Resume Next
Str_Sql = "Select ID,SeverName from YWNT_TMS_Sever order by id asc"
Set Rs_Server = Conn.Execute(Str_Sql)
Str_ServerInfo=""
While Not Rs_Server.Eof
Str_ServerInfo=Str_ServerInfo&"<img src=""images/-.gif"" alt=""没有子栏目"" width=""15"" height=""15"" border=""0""><a href=""?SeverID="&Rs_Server("ID")&"&Ranks="&Request.QueryString("Ranks")&""">"&Rs_Server("SeverName")&"</a> | "
Rs_Server.MoveNext
Wend
Rs_Server.close
Set Rs_Server = Nothing
Response.Write(Str_ServerInfo)
End Function
Function Classtop(ParentId)
If ParentId = "" Then
ParentId = 0
End If
On Error Resume Next
Str_Sql = "Select ID,ClassID,ClassName,(Select Count(id) from YWNT_TMS_MovieClass where ClassID=a.ID) as HasSub from YWNT_TMS_MovieClass a where ClassID="&ParentId&" order by ClassWith asc,id asc"
Set Rs_Class = Conn.Execute(Str_Sql)
Str_ClassInfo=""
if Rs_Class("ClassID")<>0 then
Classgo="<a href=""?ParentId="&Request.QueryString("ClassId")&"&Id="&Request.QueryString("Id")&""">返回上级目录</a> | "
end if
While Not Rs_Class.Eof
If Rs_Class("HasSub")>0 Then
Str_ClassInfo=Str_ClassInfo&"<img src=""images/+.gif"" alt=""点击展开子栏目"" width=""15"" height=""15"" border=""0""><a href=""?ParentId="&Rs_Class("ID")&"&Id="&Rs_Class("ID")&"&ClassId="&Rs_Class("ClassId")&""">"&Rs_Class("ClassName")&"</a> | "
Else
Str_ClassInfo=Str_ClassInfo&"<img src=""images/-.gif"" alt=""没有子栏目"" width=""15"" height=""15"" border=""0""><a href=""?ParentId="&Rs_Class("ClassID")&"&Id="&Rs_Class("ID")&""">"&Rs_Class("ClassName")&"</a> | "
End If
Rs_Class.MoveNext
Wend
Rs_Class.close
Set RS_class = Nothing
Response.Write(Classgo&Str_ClassInfo)
End Function
Function Featuretop()
On Error Resume Next
Str_Sql = "Select ID,FeatureName from YWNT_TMS_FeatureClass order by FeatureWith asc,id asc"
Set Rs_Class = Conn.Execute(Str_Sql)
Str_ClassInfo=""
While Not Rs_Class.Eof
Str_ClassInfo=Str_ClassInfo&"<img src=""images/-.gif"" alt=""没有子栏目"" width=""15"" height=""15"" border=""0""><a href=""?ID="&Rs_Class("ID")&""">"&Rs_Class("FeatureName")&"</a> | "
Rs_Class.MoveNext
Wend
Rs_Class.close
Set RS_class = Nothing
Response.Write(Str_ClassInfo)
End Function
Function ClassName(Id)
On Error Resume Next
Str_Sql = "Select ID,ClassName from YWNT_TMS_MovieClass where ID="&Id&" order by ClassWith asc,id asc"
Set Rs_Class = Conn.Execute(Str_Sql)
if Rs_Class.Eof then
Response.Write("栏目已被删除请再选择栏目")
else
Str_ClassInfo=Rs_Class("ClassName")
end if
Rs_Class.close
Set RS_class = Nothing
Response.Write(Str_ClassInfo)
End Function
Function FeatureName(Id)
if Id<>"" then
Str_Sql = "Select ID,FeatureName from YWNT_TMS_FeatureClass where ID="&Id&" order by FeatureWith asc,id asc"
Set Rs_Feature = Conn.Execute(Str_Sql)
if not Rs_Feature.Eof then
Str_FeatureInfo=Rs_Feature("FeatureName")
end if
Rs_Feature.close
Set RS_Feature = Nothing
Response.Write(Str_FeatureInfo)
end if
End Function
Function SeverType(SType)
Select Case SType
Case 1
SeverType="bobop2p"
Case 2
SeverType="原力p2p"
Case 3
SeverType="Qvod"
Case 4
SeverType="迅雷看看"
Case 5
SeverType="NEO泥巴"
Case 6
SeverType="OTV网络电视"
End Select
End Function
Function GetUserGroup_CheckBox(SelectArr,RowNum)
Dim n:n=0
Dim RSObj:Set RSObj=Server.CreateObject(YWNT_TMS_RS)
IF RowNum<=0 Then RowNum=3
RSObj.Open "Select ID,GroupName From YWNT_TMS_UsersGroup",Conn,1,1
GetUserGroup_CheckBox="<table width=""100%"" align=""center"" border=""0"">"
Do While Not RSObj.Eof
GetUserGroup_CheckBox=GetUserGroup_CheckBox & "<TR>"
For N=1 To RowNum
GetUserGroup_CheckBox=GetUserGroup_CheckBox & "<TD WIDTH=""" & CInt(100 / CInt(RowNum)) & "%"">"
If Instr(","&SelectArr&",",","&RSObj(0)&",")<>0 Then
GetUserGroup_CheckBox=GetUserGroup_CheckBox & "<input type=""checkbox"" checked name=""GroupID"" value="""&RSObj(0) &""">" & RSObj(1) & " "
Else
GetUserGroup_CheckBox=GetUserGroup_CheckBox & "<input type=""checkbox"" name=""GroupID"" value="""& RSObj(0)& """>" & RSObj(1) & " "
End IF
GetUserGroup_CheckBox=GetUserGroup_CheckBox & "</TD>"
RSObj.MoveNext
If RSObj.Eof Then Exit For
Next
GetUserGroup_CheckBox=GetUserGroup_CheckBox & "</TR>"
If RSObj.Eof Then Exit Do
Loop
GetUserGroup_CheckBox=GetUserGroup_CheckBox & "</TABLE>"
RSObj.Close:Set RSObj=Nothing
End Function
Function MovieRegion(MovieRegionName,MovieRegionID)
On Error Resume Next
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select ID,RegionName from YWNT_TMS_MovieRegion Order by RegionWith asc,ID asc"
Rs.open sql,Conn,1,1
if RS.eof then
Response.Write"暂时还没有影片地区请先添加地区"
else
Response.Write"<select name='"&MovieRegionName&"' id='"&MovieRegionName&"'>"
do while not RS.eof%>
<option value="<%= RS("ID") %>" <%if MovieRegionID=RS("ID") then Response.Write("selected")%>><%= RS("RegionName") %></option>
<%RS.movenext
loop
Response.Write"</select>"
end if
RS.close
set RS=nothing
End Function
Function StyleSelect(StyleSelectName,StyleSelectID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select ID,StyleName from YWNT_TMS_Style Order by ID desc"
Rs.open sql,Conn,1,1
if RS.eof then
Response.Write"暂时还没有风格请先添加风格"
else
Response.Write"<select name='"&StyleSelectName&"' id='"&StyleSelectName&"'>"
do while not RS.eof%>
<option value="<%= RS("ID") %>" <%if StyleSelectID=RS("ID") then Response.Write("selected")%>><%= RS("StyleName") %></option>
<%RS.movenext
loop
Response.Write"</select>"
end if
RS.close
set RS=nothing
End Function
Function StyleWrite(StyleID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select StyleName from YWNT_TMS_Style where ID="&StyleID&" Order by ID desc"
Rs.open sql,Conn,1,1
do while not RS.eof
Response.Write RS("StyleName")
RS.movenext
loop
RS.close
set RS=nothing
End Function
Function CssSelect(CssSelectName,CssSelectID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select ID,CssName from YWNT_TMS_Css Order by ID desc"
Rs.open sql,Conn,1,1
if RS.eof then
Response.Write"暂时还没有CSS样式请先添加CSS样式"
else
Response.Write"<select name='"&CssSelectName&"' id='"&CssSelectName&"'>"
do while not RS.eof%>
<option value="<%= RS("ID") %>" <%if CssSelectID=RS("ID") then Response.Write("selected")%>><%= RS("CssName") %></option>
<%RS.movenext
loop
Response.Write"</select>"
end if
RS.close
set RS=nothing
End Function
Function CssWrite(CssID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select CssName from YWNT_TMS_Css where ID="&CssID&" Order by ID desc"
Rs.open sql,Conn,1,1
do while not RS.eof
Response.Write RS("CssName")
RS.movenext
loop
RS.close
set RS=nothing
End Function
Function TemplateType(TType)
Select Case TType
Case 1
TemplateType="首页模版"
Case 2
TemplateType="栏目模版"
Case 3
TemplateType="列表模版"
Case 4
TemplateType="内容模版"
Case 5
TemplateType="专题模版"
Case 6
TemplateType="搜索模版"
Case 7
TemplateType="免费试看模版"
Case 8
TemplateType="全部影片模版"
End Select
End Function
Function LebRegion(MovieRegionName)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select ID,RegionName from YWNT_TMS_MovieRegion Order by RegionWith asc,ID asc"
Rs.open sql,Conn,1,1
Response.Write"<select name='"&MovieRegionName&"' id='"&MovieRegionName&"' style=""width: 150px;"">"
Response.Write"<option value="""">全部地区</option>"
do while not RS.eof%>
<option value="<%= RS("ID") %>"><%= RS("RegionName") %></option>
<%RS.movenext
loop
Response.Write"</select>"
RS.close
set RS=nothing
End Function
Function CheckZY(FildName,FildValue,Str_LinkStr)
CheckZY = Conn.execute("select count(ID) from YWNT_TMS_ZyLab where "&FildName&"="&Str_LinkStr& FildValue &Str_LinkStr)(0)
End Function
Function ClassTemplate(TemplateName,TemplateID,TemplateType)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select ID,TemplateName from YWNT_TMS_Template "
Select Case TemplateType
Case 1
sql=sql&"where TemplateType=2 or TemplateType=3 Order by ID asc"
Case 2
sql=sql&"where TemplateType=4 Order by ID asc"
Case 3
sql=sql&"where TemplateType=5 Order by ID asc"
Case else
sql=sql&"Order by ID asc"
end Select
Rs.open sql,Conn,1,1
if RS.eof then
Response.Write"暂时还没有该类的模版请添加完模版后在修改栏目模版"
else
Response.Write"<select name='"&TemplateName&"' id='"&TemplateName&"'>"
do while not RS.eof%>
<option value="<%= RS("ID") %>" <%if TemplateID=RS("ID") then Response.Write("selected")%>><%= RS("TemplateName") %></option>
<%RS.movenext
loop
Response.Write"</select>"
end if
RS.close
set RS=nothing
End Function
Function SeverP2pType(Id)
Str_Sql = "Select P2PType from YWNT_TMS_Sever where ID="&Id&" order by id asc"
Set Rs_Sever = Conn.Execute(Str_Sql)
if not Rs_Sever.Eof then
SeverP2pType=Rs_Sever("P2PType")
Rs_Sever.close
Set RS_Sever = Nothing
end if
End Function
Function AddMovieUrl(SelectName,Volume,REName,RSName,ID)
IF SelectName="p2pfilm" Then
Str_Sql = "Select P2PUrl from YWNT_TMS_Sever where ID="&CollectionMoive("SeverID",ID)&" order by id asc"
Set Rs_Sever = Conn.Execute(Str_Sql)
if not Rs_Sever.Eof then
SP2PID=Rs_Sever("P2PUrl")
SP2PID = split(SP2PID,"|")
end if
Rs_Sever.close
Set RS_Sever = Nothing
End IF
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select * from "&SelectName&" order by id asc"
Rs.open sql,Conn,1,3
for i=1 to Volume
Rs.addnew
IF SelectName="p2pfilm" Then
FileExt = LCase(Mid(Request.Form(REName&i), InStrRev(Request.Form(REName&i), ".") + 1))
ptl = LCase(Left(Request.Form(REName&i), InStrRev(Request.Form(REName&i), "://") - 1))
RS("ptl")=ptl
RS("MovieID")=ID
RS(RSName)=Request.Form(REName&i)
RS("vod")=1
RS("type")=FileExt
Select Case ptl
Case "rtsp"
RS("ptlimpl")="real"
Case "mms"
RS("ptlimpl")="ms_wms"
Case else
RS("ptlimpl")="std"
End Select
RS("filename")=Request.Form("MovieName")
RS("serverid")=SP2PID(1)
RS("opt")=0
RS("onlineserver")=SP2PID(1)
RS("GroupID")=SP2PID(2)
Else
RS(RSName)=Request.Form(REName&i)
RS("MovieID")=ID
End If
Rs.Update
next
RS.close
set RS=nothing
End Function
Function MovieUrl(SelectName,REName,RSName,ID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select * from "&SelectName&" where MovieID="&ID&""
IF SelectName="p2pfilm" Then
sql=sql&" and vod=1"
sql=sql&" order by filmid asc"
else
sql=sql&" order by id asc"
end if
Rs.open sql,Conn,1,1
do while not RS.eof
i=i+1
IF SelectName="p2pfilm" Then
Response.Write"<input type=""text"" name="""&REName&i&""" size=50 value="""&RS(RSName)&"""> 第"&i&"集 <a href=""Admin_Movie.asp?Action=DelUrl&id="&RS("filmid")&"&SelectName="&SelectName&"""><font color=""#FF0000"">删除</font></a><br>" &vbcrlf
Else
Response.Write"<input type=""text"" name="""&REName&i&""" size=50 value="""&RS(RSName)&"""> 第"&i&"集 <a href=""Admin_Movie.asp?Action=DelUrl&id="&RS("ID")&"&SelectName="&SelectName&"""><font color=""#FF0000"">删除</font></a><br>" &vbcrlf
End If
RS.movenext
loop
IF SelectName="p2pfilm" Then
Response.Write"<input name=""p2pNmu"" type=""hidden"" value="""&i&""" />"
End IF
RS.close
set RS=nothing
End Function
function movienum(SelectName,ID)
dim RS
RS=conn.execute("Select Count(ID) from "&SelectName&" where Movieid="&ID&"")
movienum=RS(0)
set RS=nothing
if isnull(movienum) then movienum=0
end function
Function EditMovieUrl(SelectName,REName,RSName,ID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="select * from "&SelectName&" where MovieID="&ID&" order by id asc"
Rs.open sql,conn,1,3
do while not Rs.eof
i=i+1
RS(RSName)=Request.Form(REName&i)
Rs.update
Rs.movenext
loop
Rs.close
set Rs=nothing
End Function
Function DelMovieUrl(ID)
conn.execute "delete from YWNT_TMS_MovieUrl WHERE MovieID in ("&ID&")"
conn.execute "delete from YWNT_TMS_P2PUrl WHERE MovieID in ("&ID&")"
conn.execute "delete from YWNT_TMS_DownUrl WHERE MovieID in ("&ID&")"
conn.execute "delete from p2pfilm WHERE MovieID in ("&ID&")"
End Function
Function AddScanningMovieUrl(SelectName,Url,REName,RSName,ID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select * from "&SelectName&""
Rs.open sql,Conn,1,3
Rs.addnew
RS(RSName)=Url
RS("MovieID")=ID
Rs.Update
RS.close
set RS=nothing
End Function
function LinkTypeW(NType)
Select Case NType
case 1
Response.Write"图片连接"
case 0
Response.Write"文字连接"
end Select
end function
function LinkAuditW(NType,ID)
Select Case NType
case 1
Response.Write"已审核"
case 0
Response.Write"<a href=""Admin_Link.asp?Action=Audit&ID="&ID&""">未审核</a>"
end Select
end function
Function AddVote(Num,VoteName,Color,ID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select * from YWNT_TMS_Vote"
Rs.open sql,Conn,1,3
for i=1 to Num
Rs.addnew
RS(VoteName)=Request.Form(VoteName&i)
RS(Color)=Request.Form(Color&i)
RS("VoteID")=ID
Rs.Update
next
RS.close
set RS=nothing
End Function
Function EditVote(VoteName,VoteNum,Color,ID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="select * from YWNT_TMS_Vote where VoteID="&ID&" order by ID asc"
Rs.open sql,conn,1,3
do while not Rs.eof
i=i+1
RS("Vote")=Request.Form(VoteName&i)
RS("VoteNum")=Request.Form(VoteNum&i)
RS("Color")=Request.Form(Color&i)
Rs.update
Rs.movenext
loop
Rs.close
set Rs=nothing
End Function
function IsStop(ADViews,ADStopViews,ADStopHits,ADHits,ADStopDate)
IsStop=false
If ( ADStopViews <> 0 and ADViews > ADStopViews) Then
IsStop=true
Exit function
ElseIf ( ADStopHits <> 0 and ADHits > ADStopHits) Then
IsStop=true
Exit function
ElseIf ( DateDiff("d",Now(),ADStopDate)<1 ) Then
IsStop=true
Exit function
End If
end function
Function EncodeIP(Sip)
Dim strIP
strIP = Split(Sip, ".")
If UBound(strIP) < 3 Then
EncodeIP = 0
Exit Function
End If
If IsNumeric(strIP(0)) = False Or IsNumeric(strIP(1)) = False Or IsNumeric(strIP(2)) = False Or IsNumeric(strIP(3)) = False Then
Sip = 0
Else
Sip = CSng(strIP(0)) * 256 * 256 * 256 + CLng(strIP(1)) * 256 * 256 + CLng(strIP(2)) * 256 + CLng(strIP(3)) - 1
End If
EncodeIP = Sip
End Function
Function LiveClassName(Id)
Sql = "Select ID,LiveClassName from YWNT_TMS_LiveClass where ID="&Id
Set Rs_LiveClass = Conn.Execute(Sql)
TVClassName=Rs_LiveClass("LiveClassName")
Rs_LiveClass.close
Set RS_LiveClass = Nothing
LiveClassName=TVClassName
End Function
Function CollectionMoive(CollectionMoiveField,CollectionMoiveID)
Dim RS
Set RS = Server.CreateObject(YWNT_TMS_RS)
RS.Open ("Select "&CollectionMoiveField&" From YWNT_TMS_Movie Where ID="&CollectionMoiveID&""), Conn, 1, 1
CollectionMoive = RS(CollectionMoiveField)
RS.Close
Set RS = Nothing
End Function
Public Function DeleteFile(FileStr)
Dim FSO
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(Server.MapPath(FileStr)) Then
FSO.DeleteFile Server.MapPath(FileStr), True
Else
DeleteFile = True
End If
Set FSO = Nothing
If Err.Number <> 0 Then
Err.Clear:DeleteFile = False
Else
DeleteFile = True
End If
End Function
Function GetSysPlay(ByVal ConfigField)
Dim GetSysPlayRS
Set GetSysPlayRS = Server.CreateObject(YWNT_TMS_RS)
GetSysPlayRS.Open ("Select "&ConfigField&" From YWNT_TMS_Sysplay"), Conn, 1, 1
GetSysPlay = GetSysPlayRS(ConfigField)
GetSysPlayRS.Close
Set GetSysPlayRS = Nothing
End Function
Sub AdminGroupBox(GroupBox,ValueName)
If Instr(","&GroupBox&",",","&ValueName&",")<>0 Then
Response.Write"checked"
end if
End Sub
Function LebGroup(SelectName,ID)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select ID,GroupName from YWNT_TMS_AdminGroup Order by ID desc"
Rs.open sql,Conn,1,1
Response.Write"<select name='"&SelectName&"' id='"&SelectName&"' style=""width: 150px;"">"
do while not RS.eof
IF RS("ID")=ID Then
Response.Write"<option value="""&RS("ID")&""" selected>"&RS("GroupName")&"</option>"
Else
Response.Write"<option value="""&RS("ID")&""">"&RS("GroupName")&"</option>"
End IF
RS.movenext
loop
Response.Write"</select>"
RS.close
set RS=nothing
End Function
Function WAdminGroup(FromName,ID)
On Error Resume Next
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select "&FromName&" from YWNT_TMS_AdminGroup Where ID="&ID&" Order by ID desc"
Rs.open sql,Conn,1,1
if Rs.Eof then
Response.Write("管理员组已被删除")
else
WAdminGroup=RS(FromName)
end if
RS.close
set RS=nothing
End Function
Function UsersIP()
Dim LoginIP
LoginIP = Trim(Request.ServerVariables("HTTP_X_FORWARDED_FOR"))
If LoginIP = "" Then LoginIP = Request.ServerVariables("REMOTE_ADDR")
UsersIP=CheckIpSafe(LoginIP)
End Function
Function CheckIpSafe(ip)
Dim test,test_i,test_j,ascnum,safe,iplen
test=Split(ip,".")
safe=True
For test_i=LBound(test) To UBound(test)
iplen=Len(test(test_i))
For test_j=1 To iplen
ascnum=Asc(Mid(test(test_i),test_j,1))
If Not (ascnum>=48 And ascnum<=57) Then
Response.Write "<html><title>警告</title><body bgcolor=""EEEEEE"" leftmargin=""60"" topmargin=""30""><font style=""font-size:16px;font-weight:bolder;color:blue;""><li>您提交的数据有恶意字符</li></font><font style=""font-size:14px;font-weight:bolder;color:red;""><br><li>您的数据已经被记录!</li><br><li>您的IP："&Request.ServerVariables("Remote_Addr")&"</li><br><li>操作日期："&Now&"</li></font></body></html>"
Response.End
End If
Next
Next
CheckIpSafe=ip
End Function
Function AddLog(Events,LogType)
Set Rs = server.CreateObject(YWNT_TMS_RS)
sql="Select * from YWNT_TMS_Log"
Rs.open sql,Conn,1,3
Rs.Addnew
RS("Events")=Events
RS("AdminName")=Session("Admin")
RS("Date")=now()
RS("AdminIP")=UsersIP()
RS("LogType")=LogType
Rs.Update
Rs.close
set Rs=nothing
End Function
function CheckLogin(GroupName)
IF Session("Admin")<>"" and Session("AdminGroup")<>"" and Session("AdminSession")=true Then
IF Instr(","&Replace(WAdminGroup("Groupbox",Session("AdminGroup"))," ","")&",",","&GroupName&",")=0 Then
call Admin_ShowErr("<li>您所在管理员组没有操作该内容的权限</li>","javascript:history.go(-1)",0)
Response.end()
End if
Else
Response.write "<script>top.location.href='"&GetConfig("WebiInstallDir")&GetConfig("AdminDir")&"Admin_Login.asp'</script>"
Response.end()
END IF
End function
function ShowAdType(ADType,ADSrc)
Dim ADExt
ADExt="图片"
If InStr(1,ADSrc,".swf",1)>0 Then ADExt="FLASH"
Select Case ADType
Case 0
ShowAdType="广告联盟"
Case 1
ShowAdType="普通"&ADExt
Case 2
ShowAdType="全屏浮动"&ADExt
Case 3
ShowAdType="上下浮动 - 右"&ADExt
Case 4
ShowAdType="上下浮动 - 左"&ADExt
Case 5
ShowAdType="渐隐消失"&ADExt
Case 6
ShowAdType="网页对话框"
Case 7
ShowAdType="移动透明对话框"
Case 8
ShowAdType="打开新窗口"
Case 9
ShowAdType="弹出新窗口"
Case 10
ShowAdType="对联式广告"&ADExt
Case else
ShowAdType="<font color=red><b>错误!将不能正确显示</b>"
End Select
end function
Sub RemoveAllCache()
Dim cachelist,i
Cachelist=split(GetallCache(),",")
If UBound(cachelist)>1 Then
For i=0 to UBound(cachelist)-1
DelCahe Cachelist(i)
Next
End If
End Sub
Function GetallCache()
Dim Cacheobj
For Each Cacheobj in Application.Contents
GetallCache = GetallCache & Cacheobj & ","
Next
End Function
Sub DelCahe(MyCaheName)
Application.Lock
Application.Contents.Remove(MyCaheName)
Application.unLock
End Sub
Sub UpWrite(Upurl,LocalUrl)
LocalUrl=Replace(LocalUrl,"Admin/",GetConfig("AdminDir"))
Call CreateDir(LocalUrl)
UpType=Split(LocalUrl, ".")
Select Case LCase(UpType(UBound(UpType)))
Case "jpeg","gif","jpg","png","bmp","exe","doc"
Call Save2Local(Upurl,server.MapPath(LocalUrl))
Case else
Call FSOSaveFile(LocalUrl, GetURL(Upurl))
End Select
End Sub
Function FSOSaveFile(FileName, Content)
On Error Resume Next
Dim FSO, FileObj
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
Set FileObj = FSO.CreateTextFile(Server.MapPath(FileName), True)
FileObj.Write Content
FileObj.Close
Set FileObj = Nothing
Set FSO = Nothing
End Function
Function CreateDir(strLocalPath)
strPath = Replace(strLocalPath, "\", "/")
Set objFolder = server.CreateObject("Scripting.FileSystemObject")
arrPathList = Split(strPath, "/")
intLevel = UBound(arrPathList)-1
For I = 1 To intLevel
If I = 1 Then
tmptPath = "/"&arrPathList(1) & "/"
Else
tmptPath = tmptPath & arrPathList(I) & "/"
End If
tmpPath = Left(tmptPath, Len(tmptPath) - 1)
If Not objFolder.FolderExists(Server.MapPath(tmpPath)) Then objFolder.CreateFolder Server.MapPath(tmpPath)
Next
Set objFolder = Nothing
End function
function toNum(s)
s=Replace(s, ".", "")
If IsNumeric(s) and s <> "" then
toNum = CLng(s)
Else
toNum = 0
End If
End function
Function GetURL(url)
on error resume next
Set objXML = Server.CreateObject("MSXML2.XMLHTTP")
objXML.open "GET",url,false
objXML.send()
if objXML.Readystate <> 4 then
Set objXML = Nothing
GetURL = False
Exit Function
end if
set objStream = Server.CreateObject("Adodb"&".Stream")
objStream.Type = 1
objStream.Mode = 3
objStream.Open
objStream.Write objXML.responseBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = "gb2312"
GetURL = objStream.ReadText
objStream.Close
Set objXML = Nothing
End Function
function getHTTPimg(url)
on error resume next
dim http
set http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then exit function
getHTTPimg=Http.responseBody
set http=nothing
if err.number<>0 then err.Clear
end function
function Save2Local(from,tofile)
on error resume next
dim geturl,objStream,imgs
geturl=trim(from)
imgs=gethttpimg(geturl)
Set objStream = Server.CreateObject("ADODB"&".Stream")
objStream.Type =1
objStream.Open
objstream.write imgs
objstream.SaveToFile tofile,2
objstream.Close()
set objstream=nothing
end function
%>